home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / sstf.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  4.6 KB  |  151 lines
  1.       subroutine sstf
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine computes the value of the small-signal transfer
  5. c function specified by the user.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=cirdat 3/15/83
  17.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  18.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  19. c spice version 2g.6  sccsid=status 3/15/83
  20.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  21.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  22.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  23. c spice version 2g.6  sccsid=flags 3/15/83
  24.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  25.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  26. c spice version 2g.6  sccsid=dc 3/15/83
  27.       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
  28.      1   kinel,kidin,kovar,kidout
  29. c spice version 2g.6  sccsid=blank 3/15/83
  30.       common /blank/ value(200000)
  31.       integer nodplc(64)
  32.       complex cvalue(32)
  33.       equivalence (value(1),nodplc(1),cvalue(1))
  34. c
  35. c
  36.       dimension string(5),save(3)
  37.       data aslash, ablnk / 1h/, 1h  /
  38. c
  39. c  setup current vector for input resistance and transfer function
  40. c
  41.       call zero8(value(lvn+1),nstop)
  42.       if (kidin.eq.10) go to 5
  43. c...  voltage source input
  44.       iptri=nodplc(kinel+6)
  45.       value(lvn+iptri)=+1.0d0
  46.       go to 20
  47. c...  current source input
  48.     5 noposi=nodplc(kinel+2)
  49.       nonegi=nodplc(kinel+3)
  50.       value(lvn+noposi)=-1.0d0
  51.       value(lvn+nonegi)=+1.0d0
  52. c
  53. c  lu decompose and solve the system of circuit equations
  54. c
  55. c...  reorder the right-hand side
  56.    20 call dcdcmp
  57.       call dcsol
  58.       value(lvn+1)=0.0d0
  59.       do 25 i=1,nstop
  60.       j=nodplc(icswpr+i)
  61.       k=nodplc(irswpf+j)
  62.       value(lvntmp+i)=value(lvn+k)
  63.    25 continue
  64.       call copy8(value(lvntmp+1),value(lvn+1),nstop)
  65. c
  66. c  evaluate transfer function
  67. c
  68.       if (nodplc(kovar+5).ne.0) go to 30
  69. c...  voltage output
  70.       noposo=nodplc(kovar+2)
  71.       nonego=nodplc(kovar+3)
  72.       trfn=value(lvn+noposo)-value(lvn+nonego)
  73.       go to 40
  74. c...  current output (through voltage source)
  75.    30 iptro=nodplc(kovar+2)
  76.       iptro=nodplc(iptro+6)
  77.       trfn=value(lvn+iptro)
  78. c
  79. c  evaluate input resistance
  80. c
  81.    40 if (kidin.eq.9) go to 50
  82. c...  current source input
  83.       zin=value(lvn+nonegi)-value(lvn+noposi)
  84.       go to 70
  85. c...  voltage source input
  86.    50 creal=value(lvn+iptri)
  87.       if (dabs(creal).ge.1.0d-20) go to 60
  88.       zin=1.0d20
  89.       go to 70
  90.    60 zin=-1.0d0/creal
  91. c
  92. c  setup current vector for output resistance
  93. c
  94.    70 call zero8(value(lvn+1),nstop)
  95.       if (nodplc(kovar+5).ne.0) go to 80
  96. c...  voltage output
  97.       value(lvn+noposo)=-1.0d0
  98.       value(lvn+nonego)=+1.0d0
  99.       go to 90
  100.    80 if (nodplc(kovar+2).ne.kinel) go to 85
  101.       zout=zin
  102.       go to 200
  103. c...  current output (through voltage source)
  104.    85 value(lvn+iptro)=+1.0d0
  105. c
  106. c  perform new forward and backward substitution
  107. c
  108. c...  reorder the right-hand side
  109.    90 call dcsol
  110.       value(lvn+1)=0.0d0
  111.       do 95 i=1,nstop
  112.       j=nodplc(icswpr+i)
  113.       k=nodplc(irswpf+j)
  114.       value(lvntmp+i)=value(lvn+k)
  115.    95 continue
  116.       call copy8(value(lvntmp+1),value(lvn+1),nstop)
  117. c
  118. c  evaluate output resistance
  119. c
  120.   100 if (nodplc(kovar+5).ne.0) go to 110
  121. c...  voltage output
  122.       zout=value(lvn+nonego)-value(lvn+noposo)
  123.       go to 200
  124. c...  current output (through voltage source)
  125.   110 creal=value(lvn+iptro)
  126.       if (dabs(creal).ge.1.0d-20) go to 120
  127.       zout=1.0d20
  128.       go to 200
  129.   120 zout=-1.0d0/creal
  130. c
  131. c  print results
  132. c
  133.   200 do 210 i=1,5
  134.       string(i)=ablnk
  135.   210 continue
  136.       ipos=1
  137.       call outnam(kovar,1,string,ipos)
  138.       call copy8(string,save,3)
  139.       call move(string,ipos,aslash,1,1)
  140.       ipos=ipos+1
  141.       locv=nodplc(kinel+1)
  142.       anam=value(locv)
  143.       call move(string,ipos,anam,1,8)
  144.       write (iofile,231) string,trfn,anam,zin,save,zout
  145.   231 format(////,'0****     small-signal characteristics'//,
  146.      1   1h0,5x,5a8,3h = ,1pd10.3,/,
  147.      2   1h0,5x,'input resistance at ',a8,12x,3h = ,d10.3,/,
  148.      3   1h0,5x,'output resistance at ',2a8,a3,3h = ,d10.3)
  149.       return
  150.       end
  151.